home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Windows Expert
/
Windows Expert.iso
/
desktop
/
om37a.zip
/
SCLPTEXT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-14
|
5KB
|
170 lines
{SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit SclpText;
{*********************** Interface **************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects;
const
sr_Recessed = 1;
sr_Raised = 0;
type
PSRect = ^TSRect;
TSRect = object(TWindow)
W,H:Integer;
State:Integer;
constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
NewX,NewY,NewW,NewH:Integer; NewState:Integer);
destructor Done;virtual;
procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
end;
type
PSText = ^TSText;
TSText = object(TSRect)
Text:Array [0..80] of Char;
DTStyle:Integer;
DTFont:hfont;
constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
destructor Done;virtual;
procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
procedure SetText(NewText:PChar);virtual;
procedure SetFont(NewFont:HFont);virtual;
end;
{*********************** Implementation *******************}
implementation
{*********************** TSRect *********************}
constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
ATitle:PChar; NewX,NewY,NewW,NewH:Integer; NewState:Integer);
begin
TWindow.Init(AParent,ATitle);
Attr.Style := ws_Child or ws_visible ;
Attr.X := NewX;
Attr.Y := NewY;
Attr.W := NewW;
Attr.H := NewH;
Attr.ID := AnID;
W := NewW;
H := NewH;
if NewState = sr_Recessed then
State := sr_Recessed
else
State := sr_Raised;
end;
destructor TSRect.Done;
begin
TWindow.Done;
end;
procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
LPts:Array[0..2] of TPoint;
RPts:Array[0..2] of TPoint;
ThePen:HPen;
Pen1:HPen;
Pen2:HPen;
TheBrush :HBrush;
OldBrush :HBrush;
OldPen:HPen;
OldBkMode:Integer;
DRect:TRect;
Ofs:Integer;
begin
TheBrush := GetStockObject(ltGray_Brush); {Draw window background}
OldBrush := SelectObject(PaintDC,TheBrush);
Rectangle(PaintDC,0,0,W,H);
SelectObject(PaintDC,OldBrush);
Ofs := 0;
LPts[0].x := Ofs; LPts[0].y := H-Ofs;
LPts[1].x := Ofs; LPts[1].y := Ofs;
LPts[2].x := W-Ofs; LPts[2].y := Ofs;
RPts[0].x := Ofs; RPts[0].y := H-Ofs;
RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
RPts[2].x := W-Ofs; RPts[2].y := Ofs;
Pen1 := CreatePen(ps_Solid,1,$00000000); {Draw a surrounding blk frame}
OldPen := SelectObject(PaintDC,Pen1);
PolyLine(PaintDC,LPts,3);
PolyLine(PaintDC,RPts,3);
SelectObject(PaintDC,OldPen);
DeleteObject(Pen1);
Ofs := 1;
LPts[0].x := Ofs; LPts[0].y := H-Ofs;
LPts[1].x := Ofs; LPts[1].y := Ofs;
LPts[2].x := W-Ofs; LPts[2].y := Ofs;
RPts[0].x := Ofs; RPts[0].y := H-Ofs;
RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
RPts[2].x := W-Ofs; RPts[2].y := Ofs;
if State = sr_Raised then
begin
Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
Pen2 := CreatePen(ps_Solid,1,$00808080);
end
else
begin
Pen1 := CreatePen(ps_Solid,1,$00808080);
Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
end;
OldPen := SelectObject(PaintDC,Pen1); {Draw the highlights}
PolyLine(PaintDC,LPts,3);
SelectObject(PaintDC,Pen2);
DeleteObject(Pen1);
PolyLine(PaintDC,RPts,3);
SelectObject(PaintDC,OldPen);
DeleteObject(Pen2);
end;
{************************ TSText ********************************}
constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
ATitle:PChar; NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
begin
TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
DTStyle := NewStyle;
StrCopy(Text,ATitle);
DTFont := 0;
end;
destructor TSText.Done;
begin
TSRect.Done;
end;
procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
OldBkMode:Integer;
DRect:TRect;
OldFont:hFont;
begin
TSRect.Paint(PaintDC,PaintInfo);
OldFont := 0;
if DTFont <> 0 then
OldFont := SelectObject(PaintDC,DTFont);
OldBkMode := SetBkMode(PaintDC,Transparent); {Draw the text}
DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
SetBkMode(PaintDC,OldBkMode);
If OldFont > 0 then
SelectObject(PaintDC,OldFont);
end;
procedure TSText.SetText(NewText:PChar);
var
DRect:TRect;
begin
StrCopy(Text,NewText);
DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
InvalidateRect(HWindow,@DRect,false);
end;
procedure TSText.SetFont(NewFont:HFont);
begin
DTFont := NewFont;
end;
end.